home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol029 / clock.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  12.1 KB  |  384 lines
  1. 0 '************************************************************
  2. 1 '*                                                          *
  3. 2 '*   Author:     Mike J. Sullivan  , Houston, Tx.           *
  4. 3 '*               12402 Campos Dr. ,Houston, Tx. 77065       *
  5. 4 '*   Date:       09/05/82                                   *
  6. 5 '*   Purpose:    Display your Basic Programs                *
  7. 6 '*   Title:      Digital Clock                              *
  8. 7 '*   Comment(s): enjoy                                      *
  9. 8 '*                                                          *
  10. 9 '************************************************************
  11. 10 KEY OFF
  12. 20 LOCATE ,,0
  13. 21 '
  14. 22 ' Day of week / Date rollover for Mike Sullivan's digital clock
  15. 23 ' DELETE lines 60-230 from the original program...
  16. 24 ' Then MERGE this code into it.  Day of week will be displayed;
  17. 25 ' day and date will change following 23:59:59.
  18. 26 ' You can also use the perpetual calendar routine in other programs.
  19. 27 ' Clayton Gaskill, Charlotte, NC
  20. 28 '
  21. 30 CLS
  22. 40 LOCATE 2,19:PRINT "M I K E   S U L L I V A N ' S  --- I B M ---"
  23. 50 LOCATE 4,19:PRINT "          DIGITAL  CLOCK   1 . 1 0  "
  24. 60 GOSUB 4060
  25. 240 DIM ONE$(7),TWO$(7),THR$(7),FOU$(7),FIV$(7)
  26. 250 DIM SIX$(7),SEV$(7),EIG$(7),NIN$(7),ZER$(7),TEMP$(7)
  27. 260 XH1=.1:XH2=.1:XM1=.1:XM2=.2:XS1=.1:XS2=.1
  28. 270 COL$(1)="  "
  29. 280 COL$(2)="  "
  30. 290 COL$(3)=STRING$(2,CHR$(219))
  31. 300 COL$(4)="  "
  32. 310 COL$(5)=STRING$(2,CHR$(219))
  33. 320 COL$(6)="  "
  34. 330 COL$(7)="  "
  35. 340 ONE$(1)="  "+STRING$(3,CHR$(219))+"   "
  36. 350 ONE$(2)="   "+CHR$(219)+CHR$(219)+"   "
  37. 360 ONE$(3)="   "+CHR$(219)+CHR$(219)+"   "
  38. 370 ONE$(4)="   "+CHR$(219)+CHR$(219)+"   "
  39. 380 ONE$(5)="   "+CHR$(219)+CHR$(219)+"   "
  40. 390 ONE$(6)="   "+CHR$(219)+CHR$(219)+"   "
  41. 400 ONE$(7)=" "+STRING$(6,CHR$(219))+" "
  42. 410 TWO$(1)=STRING$(8,CHR$(219))
  43. 420 TWO$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  44. 430 TWO$(3)="      "+CHR$(219)+CHR$(219)
  45. 440 TWO$(4)=STRING$(8,CHR$(219))
  46. 450 TWO$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  47. 460 TWO$(5)=CHR$(219)+CHR$(219)+"      "
  48. 470 TWO$(7)=STRING$(8,CHR$(219))
  49. 480 THR$(1)=STRING$(8,CHR$(219))
  50. 490 THR$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  51. 500 THR$(3)="      "+CHR$(219)+CHR$(219)
  52. 510 THR$(4)=STRING$(8,CHR$(219))
  53. 520 THR$(5)="      "+CHR$(219)+CHR$(219)
  54. 530 THR$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  55. 540 THR$(7)=STRING$(8,CHR$(219))
  56. 550 FOU$(1)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  57. 560 FOU$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  58. 570 FOU$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  59. 580 FOU$(4)=STRING$(8,CHR$(219))
  60. 590 FOU$(6)="      "+CHR$(219)+CHR$(219)
  61. 600 FOU$(5)="      "+CHR$(219)+CHR$(219)
  62. 610 FOU$(7)="      "+CHR$(219)+CHR$(219)
  63. 620 FIV$(1)=STRING$(8,CHR$(219))
  64. 630 FIV$(2)=CHR$(219)+CHR$(219)+"      "
  65. 640 FIV$(3)=CHR$(219)+CHR$(219)+"      "
  66. 650 FIV$(4)=STRING$(8,CHR$(219))
  67. 660 FIV$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  68. 670 FIV$(5)="      "+CHR$(219)+CHR$(219)
  69. 680 FIV$(7)=STRING$(8,CHR$(219))
  70. 690 SIX$(1)=STRING$(8,CHR$(219))
  71. 700 SIX$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  72. 710 SIX$(3)=CHR$(219)+CHR$(219)+"      "
  73. 720 SIX$(4)=STRING$(8,CHR$(219))
  74. 730 SIX$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  75. 740 SIX$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  76. 750 SIX$(7)=STRING$(8,CHR$(219))
  77. 760 SEV$(1)=STRING$(8,CHR$(219))
  78. 770 SEV$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  79. 780 SEV$(3)="      "+CHR$(219)+CHR$(219)
  80. 790 SEV$(4)="      "+CHR$(219)+CHR$(219)
  81. 800 SEV$(5)="      "+CHR$(219)+CHR$(219)
  82. 810 SEV$(6)="      "+CHR$(219)+CHR$(219)
  83. 820 SEV$(7)="      "+CHR$(219)+CHR$(219)
  84. 830 EIG$(1)=STRING$(8,CHR$(219))
  85. 840 EIG$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  86. 850 EIG$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  87. 860 EIG$(4)=STRING$(8,CHR$(219))
  88. 870 EIG$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  89. 880 EIG$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  90. 890 EIG$(7)=STRING$(8,CHR$(219))
  91. 900 NIN$(1)=STRING$(8,CHR$(219))
  92. 910 NIN$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  93. 920 NIN$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  94. 930 NIN$(4)=CHR$(219)+STRING$(7,CHR$(219))
  95. 940 NIN$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  96. 950 NIN$(5)="      "+CHR$(219)+CHR$(219)
  97. 960 NIN$(7)=STRING$(8,CHR$(219))
  98. 970 ZER$(1)=STRING$(8,CHR$(219))
  99. 980 ZER$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  100. 990 ZER$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  101. 1000 ZER$(4)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  102. 1010 ZER$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  103. 1020 ZER$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  104. 1030 ZER$(7)=CHR$(219)+STRING$(7,CHR$(219))
  105. 1040 H1=VAL(MID$(TIME$,1,1))
  106. 1050 H2=VAL(MID$(TIME$,2,1))
  107. 1060 M1=VAL(MID$(TIME$,4,1))
  108. 1070 M2=VAL(MID$(TIME$,5,1))
  109. 1080 S1=VAL(MID$(TIME$,7,1))
  110. 1090 S2=VAL(MID$(TIME$,8,1))
  111. 1095 XDA$=MID$(DATE$,4,2)
  112. 1100 Z$=INKEY$:IF Z$="" THEN 1110 ELSE END
  113. 1110 IF S2=XS2 THEN 1040
  114. 1115 IF DA$<>XDA$ THEN GOSUB 4060
  115. 1120 IF H1=0 THEN 1130 ELSE 1170
  116. 1130 IF H1=XH1 THEN 1450 ELSE XH1=H1
  117. 1140 FOR I=1 TO 7
  118. 1150 TEMP$(I)=ZER$(I):NEXT I
  119. 1160 GOSUB 3100:GOTO 1450
  120. 1170 IF H1=XH1 THEN 1450 ELSE XH1=H1
  121. 1180 ON H1 GOTO 1190,1220,1250,1280,1310,1340,1370,1400,1430
  122. 1190 FOR I=1 TO 7
  123. 1200 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3100
  124. 1210 GOTO 1450
  125. 1220 FOR I=1 TO 7
  126. 1230 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3100
  127. 1240 GOTO 1450
  128. 1250 FOR I=1 TO 7
  129. 1260 TEMP$(I)=THR$(I):NEXT I:GOSUB 3100
  130. 1270 GOTO 1450
  131. 1280 FOR I=1 TO 7
  132. 1290 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3100
  133. 1300 GOTO 1450
  134. 1310 FOR I=1 TO 7
  135. 1320 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3100
  136. 1330 GOTO 1450
  137. 1340 FOR I=1 TO 7
  138. 1350 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3100
  139. 1360 GOTO 1450
  140. 1370 FOR I=1 TO 7
  141. 1380 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3100
  142. 1390 GOTO 1450
  143. 1400 FOR I=1 TO 7
  144. 1410 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3100
  145. 1420 GOTO 1450
  146. 1430 FOR I=1 TO 7
  147. 1440 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3100
  148. 1450 IF H2=0 THEN 1460 ELSE 1500
  149. 1460 IF H2=XH2 THEN 1790 ELSE XH2=H2
  150. 1470 FOR I=1 TO 7
  151. 1480 TEMP$(I)=ZER$(I):NEXT I
  152. 1490 GOSUB 3140:GOTO 1790
  153. 1500 IF H2=XH2 THEN 1790 ELSE XH2=H2
  154. 1510 ON H2 GOTO 1520,1550,1580,1610,1640,1670,1700,1730,1760
  155. 1520 FOR I=1 TO 7
  156. 1530 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3140
  157. 1540 GOTO 1790
  158. 1550 FOR I=1 TO 7
  159. 1560 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3140
  160. 1570 GOTO 1790
  161. 1580 FOR I=1 TO 7
  162. 1590 TEMP$(I)=THR$(I):NEXT I:GOSUB 3140
  163. 1600 GOTO 1790
  164. 1610 FOR I=1 TO 7
  165. 1620 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3140
  166. 1630 GOTO 1790
  167. 1640 FOR I=1 TO 7
  168. 1650 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3140
  169. 1660 GOTO 1790
  170. 1670 FOR I=1 TO 7
  171. 1680 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3140
  172. 1690 GOTO 1790
  173. 1700 FOR I=1 TO 7
  174. 1710 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3140
  175. 1720 GOTO 1790
  176. 1730 FOR I=1 TO 7
  177. 1740 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3140
  178. 1750 GOTO 1790
  179. 1760 FOR I=1 TO 7
  180. 1770 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3140
  181. 1780 GOTO 3090
  182. 1790 IF M1=0 THEN 1800 ELSE 1840
  183. 1800 IF M1=XM1 THEN 2120 ELSE XM1=M1
  184. 1810 FOR I=1 TO 7
  185. 1820 TEMP$(I)=ZER$(I):NEXT I
  186. 1830 GOSUB 3210:GOTO 2120
  187. 1840 IF M1=XM1 THEN 2120 ELSE XM1=M1
  188. 1850 ON M1 GOTO 1860,1890,1920,1950,1980,2010,2040,2070,2100
  189. 1860 FOR I=1 TO 7
  190. 1870 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3210
  191. 1880 GOTO 2120
  192. 1890 FOR I=1 TO 7
  193. 1900 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3210
  194. 1910 GOTO 2120
  195. 1920 FOR I=1 TO 7
  196. 1930 TEMP$(I)=THR$(I):NEXT I:GOSUB 3210
  197. 1940 GOTO 2120
  198. 1950 FOR I=1 TO 7
  199. 1960 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3210
  200. 1970 GOTO 2120
  201. 1980 FOR I=1 TO 7
  202. 1990 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3210
  203. 2000 GOTO 2120
  204. 2010 FOR I=1 TO 7
  205. 2020 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3210
  206. 2030 GOTO 2120
  207. 2040 FOR I=1 TO 7
  208. 2050 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3210
  209. 2060 GOTO 2120
  210. 2070 FOR I=1 TO 7
  211. 2080 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3210
  212. 2090 GOTO 2120
  213. 2100 FOR I=1 TO 7
  214. 2110 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3210
  215. 2120 IF M2=0 THEN 2130 ELSE 2170
  216. 2130 IF M2=XM2 THEN 2450 ELSE XM2=M2
  217. 2140 FOR I=1 TO 7
  218. 2150 TEMP$(I)=ZER$(I):NEXT I
  219. 2160 GOSUB 3250:GOTO 2450
  220. 2170 IF M2=XM2 THEN 2450 ELSE XM2=M2
  221. 2180 ON M2 GOTO 2190,2220,2250,2280,2310,2340,2370,2400,2430
  222. 2190 FOR I=1 TO 7
  223. 2200 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3250
  224. 2210 GOTO 2450
  225. 2220 FOR I=1 TO 7
  226. 2230 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3250
  227. 2240 GOTO 2450
  228. 2250 FOR I=1 TO 7
  229. 2260 TEMP$(I)=THR$(I):NEXT I:GOSUB 3250
  230. 2270 GOTO 2450
  231. 2280 FOR I=1 TO 7
  232. 2290 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3250
  233. 2300 GOTO 2450
  234. 2310 FOR I=1 TO 7
  235. 2320 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3250
  236. 2330 GOTO 2450
  237. 2340 FOR I=1 TO 7
  238. 2350 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3250
  239. 2360 GOTO 2450
  240. 2370 FOR I=1 TO 7
  241. 2380 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3250
  242. 2390 GOTO 2450
  243. 2400 FOR I=1 TO 7
  244. 2410 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3250
  245. 2420 GOTO 2450
  246. 2430 FOR I=1 TO 7
  247. 2440 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3250
  248. 2450 IF S1=0 THEN 2460 ELSE 2500
  249. 2460 IF S1=XS1 THEN 2780 ELSE XS1=S1
  250. 2470 FOR I=1 TO 7
  251. 2480 TEMP$(I)=ZER$(I):NEXT I
  252. 2490 GOSUB 3320:GOTO 2780
  253. 2500 IF S1=XS1 THEN 2780 ELSE XS1=S1
  254. 2510 ON S1 GOTO 2520,2550,2580,2610,2640,2670,2700,2730,2760
  255. 2520 FOR I=1 TO 7
  256. 2530 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3320
  257. 2540 GOTO 2780
  258. 2550 FOR I=1 TO 7
  259. 2560 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3320
  260. 2570 GOTO 2780
  261. 2580 FOR I=1 TO 7
  262. 2590 TEMP$(I)=THR$(I):NEXT I:GOSUB 3320
  263. 2600 GOTO 2780
  264. 2610 FOR I=1 TO 7
  265. 2620 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3320
  266. 2630 GOTO 2780
  267. 2640 FOR I=1 TO 7
  268. 2650 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3320
  269. 2660 GOTO 2780
  270. 2670 FOR I=1 TO 7
  271. 2680 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3320
  272. 2690 GOTO 2780
  273. 2700 FOR I=1 TO 7
  274. 2710 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3320
  275. 2720 GOTO 2780
  276. 2730 FOR I=1 TO 7
  277. 2740 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3320
  278. 2750 GOTO 2780
  279. 2760 FOR I=1 TO 7
  280. 2770 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3320
  281. 2780 IF S2=0 THEN 2790 ELSE 2820
  282. 2790 FOR I=1 TO 7
  283. 2800 TEMP$(I)=ZER$(I):NEXT I
  284. 2810 GOSUB 3360:GOTO 3090
  285. 2820 XS2=S2:ON S2 GOTO 2830,2860,2890,2920,2950,2980,3010,3040,3070
  286. 2830 FOR I=1 TO 7
  287. 2840 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3360
  288. 2850 GOTO 3090
  289. 2860 FOR I=1 TO 7
  290. 2870 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3360
  291. 2880 GOTO 3090
  292. 2890 FOR I=1 TO 7
  293. 2900 TEMP$(I)=THR$(I):NEXT I:GOSUB 3360
  294. 2910 GOTO 3090
  295. 2920 FOR I=1 TO 7
  296. 2930 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3360
  297. 2940 GOTO 3090
  298. 2950 FOR I=1 TO 7
  299. 2960 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3360
  300. 2970 GOTO 3090
  301. 2980 FOR I=1 TO 7
  302. 2990 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3360
  303. 3000 GOTO 3090
  304. 3010 FOR I=1 TO 7
  305. 3020 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3360
  306. 3030 GOTO 3090
  307. 3040 FOR I=1 TO 7
  308. 3050 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3360
  309. 3060 GOTO 3090
  310. 3070 FOR I=1 TO 7
  311. 3080 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3360
  312. 3090 XS2=S2:GOTO 1040
  313. 3100 FOR I=1 TO 7
  314. 3110 LOCATE 9+I,5:PRINT TEMP$(I)
  315. 3120 NEXT I
  316. 3130 RETURN
  317. 3140 FOR I=1 TO 7
  318. 3150 LOCATE 9+I,14:PRINT TEMP$(I)
  319. 3160 NEXT I
  320. 3170 FOR I=1 TO 7
  321. 3180 LOCATE 9+I,26:PRINT COL$(I)
  322. 3190 NEXT I
  323. 3200 RETURN
  324. 3210 FOR I=1 TO 7
  325. 3220 LOCATE 9+I,32:PRINT TEMP$(I)
  326. 3230 NEXT I
  327. 3240 RETURN
  328. 3250 FOR I=1 TO 7
  329. 3260 LOCATE 9+I,42:PRINT TEMP$(I)
  330. 3270 NEXT I
  331. 3280 FOR I=1 TO 7
  332. 3290 LOCATE 9+I,54:PRINT COL$(I)
  333. 3300 NEXT I
  334. 3310 RETURN
  335. 3320 FOR I=1 TO 7
  336. 3330 LOCATE 9+I,60:PRINT TEMP$(I)
  337. 3340 NEXT I
  338. 3350 RETURN
  339. 3360 FOR I=1 TO 7
  340. 3370 LOCATE 9+I,70:PRINT TEMP$(I)
  341. 3380 NEXT I
  342. 3390 RETURN
  343. 4060 MO$=MID$(DATE$,1,2)
  344. 4070 DA$=MID$(DATE$,4,2)
  345. 4080 YR$=MID$(DATE$,9,2)
  346. 4081 YR4$=MID$(DATE$,7,4)
  347. 4090 MO=VAL(MO$)
  348. 4091 YR=VAL(YR$)
  349. 4092 YR4=VAL(YR4$)
  350. 4100 ON MO GOTO 4110,4120,4130,4140,4150,4160,4170,4180,4190,4200,4210,4220
  351. 4110 MO$="JANUARY":GOTO 4230
  352. 4120 MO$="FEBRUARY":GOTO 4230
  353. 4130 MO$="MARCH":GOTO 4230
  354. 4140 MO$="APRIL":GOTO 4230
  355. 4150 MO$="MAY":GOTO 4230
  356. 4160 MO$="JUNE":GOTO 4230
  357. 4170 MO$="JULY":GOTO 4230
  358. 4180 MO$="AUGUST":GOTO 4230
  359. 4190 MO$="SEPTEMBER":GOTO 4230
  360. 4200 MO$="OCTOBER":GOTO 4230
  361. 4210 MO$="NOVEMBER":GOTO 4230
  362. 4220 MO$="DECEMBER":GOTO 4230
  363. 4230 YEAR%=YR4
  364. 4233 MONTH%=MO
  365. 4235 DAY%=VAL(DA$)
  366. 4240 IF MONTH%=1 OR MONTH%=2 THEN 4250 ELSE 4270
  367. 4250 YEAR%=YEAR%-1
  368. 4260 MONTH%=MONTH%+12
  369. 4270 DOW.K%=DAY%+YEAR%+MONTH%*2+YEAR%\4+YEAR%\400+(MONTH%+1)*3\5+2-YEAR%\100
  370. 4330 DOW%=DOW.K% MOD 7
  371. 4360 IF DOW%=0 OR DOW%=1 THEN DOW%=DOW%+7
  372. 4370 DOW%=DOW%-1
  373. 4500 ON DOW% GOTO 4510,4520,4530,4540,4550,4560,4570
  374. 4510 DOW$="MONDAY":GOTO 4580
  375. 4520 DOW$="TUESDAY":GOTO 4580
  376. 4530 DOW$="WEDNESDAY":GOTO 4580
  377. 4540 DOW$="THURSDAY":GOTO 4580
  378. 4550 DOW$="FRIDAY":GOTO 4580
  379. 4560 DOW$="SATURDAY":GOTO 4580
  380. 4570 DOW$="SUNDAY":GOTO 4580
  381. 4580 LOCATE 22,29:PRINT DOW$;", ";MO$;" ";DA$;", ";YR4$;"     "
  382. 4590 RETURN
  383. TURDAY":GOTO 4580
  384. 4570 DOW$="SUNDAY